home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / libs / tool6v12 / demodt.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-01  |  7KB  |  231 lines
  1. Program DemoDateTime;
  2.  
  3. { Purpose....... Demonstrates the use of the following units: Win,DateTime
  4.   Comments...... None
  5.   Author........ Thayne Breetzke
  6.   Date.......... 22 March 1994                                               }
  7.  
  8. Uses
  9.   Crt,
  10.   Cursor,
  11.   Screen,
  12.   Strings,
  13.   Input,
  14.   Windows,
  15.   DateTime;
  16.  
  17. Var
  18.   Hour,
  19.   Min,
  20.   Sec,
  21.   Day,
  22.   Month    : Byte;
  23.   Year     : Word;
  24.   Seconds  : LongInt;
  25.  
  26.  
  27. {$F+}
  28. Procedure UpdateProc(Var Key: Char; Var Extended: Boolean; UpdateVar: Word);
  29.  
  30. Begin
  31. end;
  32. {$F-}
  33.  
  34.  
  35. Procedure ShowCountrySettings;
  36.  
  37. Begin
  38.   OpenWindow(11,8,70,22,'',' Press any key to continue ',SingleFrame,15+7*16,15+7*16,True);
  39.   WriteMem(13,10,'The following are the country settings on your computer:');
  40.   WriteMem(13,12,'Country code:               '+NumToStr(CountryCode,0,0,False));
  41.   WriteMem(13,13,'Country date format:        '+NumToStr(CountryDateFormat,0,0,False));
  42.   WriteMem(13,14,'Country time format:        '+NumToStr(CountryTimeFormat,0,0,False));
  43.   WriteMem(13,15,'Country currency:           '+CountryCurrency);
  44.   WriteMem(13,16,'Country thousand separator: '+CountryThouSep);
  45.   WriteMem(13,17,'Country decimal separator:  '+CountryDecSep);
  46.   WriteMem(13,18,'Country date separator:     '+CountryDateSep);
  47.   WriteMem(13,19,'Country time separator:     '+CountryTimeSep);
  48.   WriteMem(13,20,'Country currency format:    '+NumToStr(CountryCurrFormat,0,0,False));
  49.   WaitForKeypress;
  50.   CloseWindow;
  51. end;
  52.  
  53.  
  54. Function ReadADate(Var Day, Month: Byte; Var Year: Word): Boolean;
  55.  
  56. Var
  57.   Key        : Char;
  58.   Extended   : Boolean;
  59.   InputString: String;
  60.   ErrorCode  : Byte;
  61.  
  62. Begin
  63.   {OpenWindow(16,13,65,17,'','',SingleFrame,15+7*16,15+7*16,True);}
  64.   WriteMem(18,15,'Enter a date (DD/MM/YYYY):');
  65.   InputString := '';
  66.   Repeat
  67.     ReadString(InputString,44,15,10,12,[#32..#126],True,[#13,#10,#27],[#45],
  68.                Key,Extended,True,False,112,UpdateProc,0);
  69.     InputString := LeftTrim(RightTrim(InputString));
  70.     Day := StrToNum(Copy(InputString,1,2));
  71.     If StringError = 0 then
  72.       Month := StrToNum(Copy(InputString,4,2));
  73.     If StringError = 0 then
  74.       Year := StrToNum(Copy(InputString,7,4));
  75.     If not ValidDate(Day,Month,Year,ErrorCode) then
  76.       StringError := 255;
  77.     If StringError <> 0 then
  78.       Begin
  79.         Sound(1000);
  80.         Delay(10);
  81.         NoSound;
  82.       end;
  83.   until (StringError = 0) and (Length(InputString) = 10) or (InputString = '');
  84.   {CloseWindow;}
  85.   ReadADate := InputString <> '';
  86. end;
  87.  
  88.  
  89. Procedure ShowDate(Day, Month: Byte; Year: Word);
  90.  
  91. Begin
  92.   OpenWindow(11,10,70,20,'',' Press any key to continue ',SingleFrame,15+7*16,15+7*16,True);
  93.   WriteMem(37,12,NumToStr(Day,2,0,True)+'/'+NumToStr(Month,2,0,True)+'/'+NumToStr(Year,2,0,True));
  94.   WriteMem(14,14,'Leap year: ');
  95.   If LeapYear(Year) then
  96.     WriteMem(33,14,'Yes')
  97.   else
  98.     WriteMem(33,14,'No');
  99.   WriteMem(14,15,'Days in month:     '+NumToStr(DaysInMonth(Month,Year),0,0,False));
  100.   WriteMem(14,16,'Day of the week:   '+NumToStr(DayOfWeek(Day,Month,Year),0,0,False)+
  101.            ' ('+DayOfWeekDesc(DayOfWeek(Day,Month,Year))+')');
  102.   WriteMem(14,17,'Day of the year:   '+NumToStr(DayOfYear(Day,Month,Year),0,0,False));
  103.   WriteMem(14,18,'Month description: '+MonthDesc(Month));
  104.   WaitForKeypress;
  105.   CloseWindow;
  106. end;
  107.  
  108.  
  109. Procedure ShowDateFormats(Day, Month: Byte; Year: Word);
  110.  
  111. Var
  112.   Count: Byte;
  113.  
  114. Begin
  115.   OpenWindow(11,8,70,23,'',' Press any key to continue ',SingleFrame,15+7*16,15+7*16,True);
  116.   WriteMem(37,10,NumToStr(Day,2,0,True)+'/'+NumToStr(Month,2,0,True)+'/'+NumToStr(Year,2,0,True));
  117.   For Count := 0 to 9 do
  118.     WriteMem(14,12+Count,'Format '+NumToStr(Count,0,0,False)+': '+DateStr(Day,Month,Year,Count,CountryDateSep));
  119.   WaitForKeypress;
  120.   CloseWindow;
  121. end;
  122.  
  123.  
  124. Function ReadATime(Var Hour, Min, Sec: Byte): Boolean;
  125.  
  126. Var
  127.   Key        : Char;
  128.   Extended   : Boolean;
  129.   InputString: String;
  130.   ErrorCode  : Byte;
  131.  
  132. Begin
  133.   {OpenWindow(16,13,65,17,'','',SingleFrame,15+7*16,15+7*16,True);}
  134.   WriteMem(18,15,'Enter a time (HH:MM:SS):'+Spaces(20));
  135.   InputString := '';
  136.   Repeat
  137.     ReadString(InputString,42,15,8,10,[#32..#126],True,[#13,#10,#27],[#45],
  138.                Key,Extended,True,False,112,UpdateProc,0);
  139.     InputString := LeftTrim(RightTrim(InputString));
  140.     Hour := StrToNum(Copy(InputString,1,2));
  141.     If StringError = 0 then
  142.       Min := StrToNum(Copy(InputString,4,2));
  143.     If StringError = 0 then
  144.       Sec := StrToNum(Copy(InputString,7,4));
  145.     If StringError <> 0 then
  146.       Begin
  147.         Sound(1000);
  148.         Delay(10);
  149.         NoSound;
  150.       end;
  151.   until (StringError = 0) and (Length(InputString) = 8) or (InputString = '');
  152.   {CloseWindow;}
  153.   ReadATime := InputString <> '';
  154. end;
  155.  
  156.  
  157. Procedure ShowTimeFormats(Hour, Mi, Sec: Byte);
  158.  
  159. Var
  160.   Count: Byte;
  161.  
  162. Begin
  163.   OpenWindow(11,9,70,22,'',' Press any key to continue ',SingleFrame,15+7*16,15+7*16,True);
  164.   WriteMem(37,11,NumToStr(Hour,2,0,True)+':'+NumToStr(Min,2,0,True)+':'+NumToStr(Sec,2,0,True));
  165.   For Count := 0 to 6 do
  166.     WriteMem(14,13+Count,'Format '+NumToStr(Count,0,0,False)+': '+TimeStr(Hour,Min,Sec,Count,CountryTimeSep));
  167.   WaitForKeypress;
  168.   CloseWindow;
  169. end;
  170.  
  171.  
  172. Function ReadSeconds(Var Seconds: LongInt): Boolean;
  173.  
  174. Var
  175.   Key        : Char;
  176.   Extended   : Boolean;
  177.   InputString: String;
  178.   ErrorCode  : Byte;
  179.  
  180. Begin
  181.   {OpenWindow(16,13,65,17,'','',SingleFrame,15+7*16,15+7*16,True);}
  182.   WriteMem(18,15,'Enter a longint:'+Spaces(20));
  183.   InputString := '';
  184.   Repeat
  185.     ReadString(InputString,34,15,12,14,[#32..#126],True,[#13,#10,#27],[#45],
  186.                Key,Extended,True,False,112,UpdateProc,0);
  187.     InputString := LeftTrim(RightTrim(InputString));
  188.     Seconds := StrToNum(InputString);
  189.     If StringError <> 0 then
  190.       Begin
  191.         Sound(1000);
  192.         Delay(10);
  193.         NoSound;
  194.       end;
  195.   until (StringError = 0) or (InputString = '');
  196.   {CloseWindow;}
  197.   ReadSeconds := InputString <> '';
  198. end;
  199.  
  200.  
  201. Procedure ShowSecToTime(Seconds: LongInt);
  202.  
  203. Begin
  204.   OpenWindow(16,13,65,17,'',' Press a key to end demo ',SingleFrame,15+7*16,15+7*16,True);
  205.   WriteMem(17,15,Center(NumToStr(Seconds,2,0,False)+' seconds = '+SecondsToTime(Seconds,0,CountryTimeSep),48));
  206.   WaitForKeypress;
  207.   CloseWindow;
  208. end;
  209.  
  210.  
  211. Begin
  212.   TextAttr := 7;
  213.   CursorOff;
  214.   ClearArea(1,1,80,25,7,'▒');
  215.   DrawBox(4,2,77,4,'','',DoubleFrame,15+1*16,14+1*16,True);
  216.   WriteMem(5,3,Center('The "Complete" Borland Turbo Pascal 6.0 Toolbox',72));
  217.   ShowCountrySettings;
  218.   OpenWindow(16,13,65,17,'','',SingleFrame,15+7*16,15+7*16,True);
  219.   If ReadADate(Day,Month,Year) then
  220.     Begin
  221.       ShowDate(Day,Month,Year);
  222.       ShowDateFormats(Day,Month,Year);
  223.     end;
  224.   If ReadATime(Hour,Min,Sec) then
  225.     ShowTimeFormats(Hour,Min,Sec);
  226.   If ReadSeconds(Seconds) then
  227.     ShowSecToTime(Seconds);
  228.   CloseWindow;
  229.   ClrScr;
  230.   CursorOn(False);
  231. end.